#|________________________________________________
 | 
 | COLOR AND SYMBOL PALLETS
 |________________________________________________
 |#


    
(setf *color-pallet* nil)
(setf *symbol-pallet* nil)


(defun color-pallet ()
  (send self :toggle-pallet "color"))

(defun symbol-pallet ()
  (send self :toggle-pallet "symbol"))

(defmeth graph-proto :set-selection-color () 
  (send self :toggle-pallet "color"))

(defmeth graph-proto :set-selection-symbol () 
  (send self :toggle-pallet "symbol"))

(defmeth graph-proto :selection-overlay (&optional (objid nil set))
"Args: (&optional objid) selection-overlay slot."
  (unless (send self :has-slot 'selection-overlay)
          (send self :add-slot 'selection-overlay))
  (if set (setf (slot-value 'selection-overlay) objid))
  (slot-value 'selection-overlay))

(defmeth graph-proto :color-pallet (&optional (logical nil set))
"Args: (&optional logical) indicates whether color pallet is showing."
  (unless (send self :has-slot 'color-pallet)
          (send self :add-slot 'color-pallet))
  (if set (setf (slot-value 'color-pallet) logical))
  (slot-value 'color-pallet))

(defmeth graph-proto :symbol-pallet (&optional (logical nil set))
"Args: (&optional logical) indicates whether symbol pallet is showing."
  (unless (send self :has-slot 'symbol-pallet)
          (send self :add-slot 'symbol-pallet))
  (if set (setf (slot-value 'symbol-pallet) logical))
  (slot-value 'symbol-pallet))

(defmeth graph-proto :toggle-color-pallet () 
  (send self :toggle-pallet "color"))

(defmeth graph-proto :toggle-symbol-pallet ()
  (send self :toggle-pallet "symbol"))

(defmeth graph-proto :toggle-pallet (type)
  (let* ((selection-overlay (send self :selection-overlay))
         (color-pallet (send self :color-pallet))
         (symbol-pallet (send self :symbol-pallet)))

    (when (not selection-overlay) 
          (send self :selection-overlay (send selection-overlay-proto :new))
          (apply #'send self :margin (+ (send self :margin) '(0 20 0 0)))
          (send self :add-overlay (send self :selection-overlay))
          )

    (cond 
      ((equal type "color")  (send self :color-pallet  (not (send self :color-pallet))))
      ((equal type "symbol") (send self :symbol-pallet (not (send self :symbol-pallet)))))
    
    (when (and (not (send self :symbol-pallet))
               (not (send self :color-pallet)))
          (apply #'send self :margin (- (send self :margin) '(0 20 0 0)))
          (send self :delete-overlay selection-overlay)
          (send self :selection-overlay nil)
          )
    
    (send self :redraw)
    ))

     
(defmeth graph-proto :toggle-symbol-pallet ()
  (let* ((pallet-overlay (send self :selection-overlay))
         (color-pallet (send self :color-pallet))
         (symbol-pallet (send self :symbol-pallet)))
    (cond
      ((not pallet-overlay) 
       (send self :add-pallet-overlay)
       (send self :show-symbol-pallet)
       )
      ((not symbol-pallet)
       (send self :show-symbol-pallet))
      (color-pallet
       (send self :hide-symbol-pallet))
      (t
       (send self :hide-symbol-pallet)
       (send self :delete-pallet-overlay)))
    ))    


(defmeth graph-proto :toggle-selection-pallets ()
"Args: none
Toggels pallet overlay and pallets to toolbar."
  (let* ((selection-overlay (send self :selection-overlay)))
    (cond 
      (selection-overlay
       (apply #'send self :margin (- (send self :margin) '(0 20 0 0)))
       (send self :delete-overlay selection-overlay)
       (send self :selection-overlay nil)
       (send self :redraw)
       )
      (t
       (send self :selection-overlay (send selection-overlay-proto :new))
       (apply #'send self :margin (+ (send self :margin) '(0 20 0 0)))
       (send self :add-overlay (send self :selection-overlay))
       (send self :redraw)
       ))
    ))

(setf color-16-list (list 'WHITE 'PINK 'LIGHT-BLUE 'YELLOW  'ORANGE  'CYAN 
'GREEN   'MAGENTA  'RED 'DARK-RED 'DARK-GREEN 'VIOLET 'BLUE 
'GREY  'BROWN   'BLACK))

(defproto selection-overlay-proto '(color-mode color-x color-y symbol-x symbol-y) nil vista-graph-overlay-proto)

(defmeth selection-overlay-proto :isnew ()
  (send self :color-mode *color-mode*)
  (call-next-method)
  )

(defmeth selection-overlay-proto :color-mode 
  (&optional (logical nil set))
  (if set (setf (slot-value 'color-mode) logical))
  (slot-value 'color-mode))

(defmeth selection-overlay-proto :color-x 
  (&optional (coordinate nil set))
  (if set (setf (slot-value 'color-x) coordinate))
  (slot-value 'color-x))

(defmeth selection-overlay-proto :color-y 
  (&optional (coordinate nil set))
  (if set (setf (slot-value 'color-y) coordinate))
  (slot-value 'color-y))

(defmeth selection-overlay-proto :symbol-x 
  (&optional (coordinate nil set))
  (if set (setf (slot-value 'symbol-x) coordinate))
  (slot-value 'symbol-x))

(defmeth selection-overlay-proto :symbol-y 
  (&optional (coordinate nil set))
  (if set (setf (slot-value 'symbol-y) coordinate))
  (slot-value 'symbol-y))

(defmeth selection-overlay-proto :which-button 
  (x y button-x button-y button-width button-height)
  (let* ((indices-x (which (< button-x x (+ button-x button-width))))
         (indices-y (which (< button-y y (+ button-y button-height))))
         (index (intersection indices-x indices-y)))
    (first index)))


(defmeth selection-overlay-proto :which-color (x y)
  (let* ((color-x (send self :color-x))
         (color-y (send self :color-y))
         (button-n (if (or color-x color-y)
                       (send self :which-button x y color-x color-y 8 10)
                       nil))
         (color-16 (if button-n (select color-16-list button-n) nil))
         )
    color-16))

(defmeth selection-overlay-proto :which-symbol (x y)
  (let* ((symbol-x (send self :symbol-x))
         (symbol-y (send self :symbol-y))
         (button-n (if (or symbol-x symbol-y)
                       (send self :which-button x y symbol-x symbol-y 8 10)
                       nil))
         (symbol (if button-n (select *plot-symbols* button-n) nil))
         )
    symbol))

(defmeth selection-overlay-proto :redraw ()
   (let* ((graph (send self :graph))
          (color-pallet (send graph :color-pallet))
          (symbol-pallet (send graph :symbol-pallet))
          (width (send graph :canvas-width))
          (height (send graph :canvas-height))
          (margin (send graph :margin))
          (color (send graph :draw-color))
          (backcolor (send graph :back-color))
          (bar-x 5)                  ;x-location of first bar
          (bar-y 18)                 ;y-location of both bars
          (bar-thickness 15)         ;thickness of both bars (should be odd)
          (bar-gap 5)                ;gap between end of first and beginning of second bar
          (color-patch-width 8)      ;width of each color patch
          (color-bar-thickness  bar-thickness) 
          (symbol-bar-thickness bar-thickness)
          (symbol-button-size (- symbol-bar-thickness 4))
          (color-patch-height (- color-bar-thickness 4))
          (color-bar-length   (+ 5 (* 16 color-patch-width)))
          (symbol-bar-length  (+ 4 (* 12 (+ symbol-button-size 1))))
          (color-bar-x bar-x)
          (color-bar-y bar-y)
          (symbol-bar-x (+ bar-x (if color-pallet color-bar-length 0) bar-gap))
          (symbol-bar-y bar-y)
          (vertical (< width (+ 10 (if color-pallet color-bar-length 0) symbol-bar-length)))
          (x) (y) (cx) (cy) (knt 0) (color-x) (color-y) (symbol-x) (symbol-y)
          )
     (when color-pallet
           (send graph :draw-color 'white)
           (send graph :paint-rect 
                 (- color-bar-x 1)
                 (- color-bar-y 0)
                 (+ color-bar-length 2)
                 (+ color-bar-thickness 1))
           (send graph :draw-color 'black) 'black
           (send graph :frame-rect 
                 (- color-bar-x 1)
                 (- color-bar-y 0)
                 (+ color-bar-length 2)
                 (+ color-bar-thickness 1))
           (send graph :draw-color 'grey) 
           (send graph :frame-rect 
                 (- color-bar-x 1)
                 (- color-bar-y 0)
                 (+ color-bar-length 1)
                 (+ color-bar-thickness 0))
           (dotimes (i 16) 
                    (setf x (+ color-bar-x 2 (* i 8)))
                    (setf y (+ color-bar-y 2))
                    (setf color-x (append color-x (list x)))
                    (setf color-y (append color-y (list y)))
                    (send graph :draw-color (nth i color-16-list))
                    (send graph :paint-rect (1+ x) (1+ y) 7 9)
                    (send graph :draw-color 'black) 
                    (send graph :frame-rect x y 9 11)
                    )
           (send self :color-x color-x)
           (send self :color-y color-y)
           )
     (when symbol-pallet
           (cond
             (vertical
              (when (/= (select (send graph :margin) 2) 21)
                    (setf (select margin 2) 21)
                    (apply #'send graph :margin margin) )
              (setf symbol-bar-x (- width symbol-bar-thickness 1))
              (setf symbol-bar-y (+ symbol-bar-y symbol-bar-thickness 8))
              (send graph :draw-color 'toolbar-background)
              (send graph :paint-rect 
                    (- width -1 (third margin)) (- (second margin) 2)
                    (- (third margin) 1) (- height -3 (fourth margin)))
              (send graph :draw-color 'black)
              (send graph :draw-line
                    (- width -1 (third margin)) (- (second margin) 3)
                    (- width -1 (third margin)) height)
              )
             (t
              (when (/= (select (send graph :margin) 2) 0)
                    (setf (select margin 2) 0)
                    (apply #'send graph :margin margin))
              (setf symbol-bar-x (+ bar-x (if color-pallet (+ bar-gap color-bar-length) 0)))
              ))
           (send graph :draw-color 'white)
           (send graph :paint-rect 
                 (- symbol-bar-x 1)
                 (- symbol-bar-y 0)
                 (+ (if vertical symbol-bar-thickness symbol-bar-length) 2)
                 (+ (if vertical symbol-bar-length symbol-bar-thickness) 1))
           (send graph :draw-color 'black) 
           (send graph :frame-rect
                 (- symbol-bar-x  1)
                 symbol-bar-y
                 (+ (if vertical symbol-bar-thickness symbol-bar-length) 2)
                 (+ (if vertical symbol-bar-length symbol-bar-thickness) 1)) 
           (send graph :draw-color 'grey) 
           (send graph :frame-rect 
                 (- symbol-bar-x 1)
                 symbol-bar-y
                 (+ (if vertical symbol-bar-thickness symbol-bar-length) 1)
                 (+ (if vertical symbol-bar-length symbol-bar-thickness) 0))
           (dotimes (i 12)
                    (setf cx (if (< i 5) 8 9))
                    (setf cy (if (< i 5) 7 8))
                    (setf x (+ symbol-bar-x (if vertical 0 (* i 12)) 2))
                    (setf y (+ symbol-bar-y (if vertical (* i 12) 0) 2))
                    (setf symbol-x (append symbol-x (list x)))
                    (setf symbol-y (append symbol-y (list y)))
                    (send graph :frame-rect x y symbol-button-size symbol-button-size)
                    (send graph :draw-color 'white)
                    (send graph :paint-rect (1+ x) (1+ y) 
                          (- symbol-button-size 2) (- symbol-button-size 2))
                    (send graph :draw-color 'black)
                    (send graph :draw-symbol 
                          (nth i *PLOT-SYMBOLS*)
                          nil
                          (if vertical (+ symbol-bar-x -1 cx) (+ symbol-bar-x (* i 12) cy))
                          (if vertical (+ symbol-bar-y (* i 12) cy) (+ symbol-bar-y -1 cx))
                          )
                    )
            
           (send self :symbol-x symbol-x)
           (send self :symbol-y symbol-y)
           )
     (send graph :draw-color color)
     ))
  

(defmeth selection-overlay-proto :do-click (x y m1 m2)
  (when (< 15 y 32)
        (send (send self :graph) :line-type 'solid)
        (let* ((graph (send self :graph))
               (hilight (send graph :points-selected))
               (link-list (remove 'nil (send graph :links)))
               (color  (send self :which-color x y))
               (symbol (send self :which-symbol x y)))
          (when (and hilight (or color symbol))
                (when color (send graph :point-color hilight color))
                (when symbol (send graph :point-symbol hilight symbol))
                (when link-list
                      (dolist (plot link-list)
                              ;(send plot :use-color t)
                              (when color (send plot :point-color hilight color))
                              (when symbol (send plot :point-symbol hilight symbol))
                              (send plot :redraw-content)
                              (send plot :points-selected hilight)))
                (send graph :redraw-content)
                (send graph :points-selected hilight))
          )))

                                                                                                                                  